home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / difedl.com / DIFEDL.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-12-07  |  31.3 KB  |  780 lines
  1. {$A+,B-,D+,E-,F-,I+,L+,N-,O-,R+,S+,V+} {place last for debugging}
  2. {$A+,B-,D-,E-,F-,I+,L-,N-,O-,R-,S-,V+} {place last for normal use}
  3.  
  4. {$M 4096,0,655360}
  5.  
  6. program DifEdl;
  7.  
  8. const
  9.    NAME_AND_VERSION = 'DifEdl Version 1.0 of December 07, 1988';
  10.  
  11. {****************************************************************************}
  12. {
  13. This program was written by Carley Phillips for Longhorn Systems, Inc., and
  14. and is hereby placed in the PUBLIC DOMAIN with no support whatsoever.
  15. However, user comments and bug reports are welcome and should be directed
  16. to Carley Phillips on CompuServe at User ID 76630,3312.
  17. }
  18. {****************************************************************************}
  19. {
  20. DifEdl compares two text files, and OldFile and a NewFile, and produces
  21. a list of the differences on standard output (which may, of course, be
  22. re-directed to a file).  The difference list is in a special format
  23. acceptable as input to EDLIN, the editor supplied with all versions of
  24. DOS.  In particular,  if you execute
  25.  
  26.    "DifEdl old\MyFile new\MyFile >MyFile.DED"
  27.  
  28. you will then be able to execute
  29.  
  30.    "EdLin old\MyFile <MyFile.DED >EdlFile"
  31.  
  32. The result will be that EdLin will update the old MyFile so that it is
  33. identical to the new MyFile.  The purpose of re-directing the output of
  34. EdLin to EdlFile is so you can use an editor or file browser to verify
  35. that the lines deleted were the correct lines.  This is possible because
  36. of an unusual feature of DifEdl explained below.
  37.  
  38. This program was written to allow publishing changes and enhancements to
  39. proprietary files without posting the proprietary files themselves.
  40. Suppose, for example, you have made some major enhancements to the Turbo
  41. Graphics Toolbox that you wish to share.  By using DifEdl to produce a file
  42. containing only your changes, you could then post only the change file on
  43. bulletin boards and thus offend no one.
  44.  
  45. Obviously it's just a suggestion, but we always use the extension of "ded"
  46. to indicate difference files produced from DifEdl.  That extension is not]
  47. in common use, and it helps to identify what file is expected to be updated.
  48.  
  49. An interesting feature of the difference file is it not only includes
  50. delete and insert instructions plus the added lines, but also includes all
  51. lines DELETED from the original file.  This is done in such a way that you
  52. may view both the added lines and the deleted lines in the difference file
  53. with your favorite editor or file browser and update your old file manually
  54. if desired.
  55.  
  56. However, the fact that deleted lines are included in the difference file has
  57. another benefit: assuming you use EdLin to apply the updates, you will be
  58. able to re-direct the screen output of EdLin to still another file for
  59. review.  This EdLin output file will show not only insertions, but also the
  60. lines actually deleted and the lines that SHOULD have been deleted for
  61. comparison.  This is useful if you're not sure if your "original" matches
  62. the one from which the MyFile.Ded was created.
  63.  
  64. Five options may appear after the file names: /R#, /D#, /M#, /B#, and /N
  65. where # is a number.
  66.    /R allows changing the number of successive lines that must match in order
  67.       to re-acquire synchronization after a mis-match is detected.  The default
  68.       value is 5.
  69.    /D allows changing the number of successive lines that must match after
  70.       a very small (less than /R# lines) file difference has been found.
  71.       The default value is 1.
  72.    /M allows changing the maximum line size from 253 to some other number
  73.       so that more lines may be kept in memory.  This is useful when you have
  74.       two files that are different for an extrememly long series of lines.  If
  75.       you get a message indicating that the files are too different, try /M to
  76.       set the maximum line size to the actual length of the longest line in
  77.       your files.  Note EdLin has a maximum line length of 253.
  78.    /B allows changing the block size used to keep EdLin's internal buffer
  79.       from overflowing.  While EdLin can edit a file of any size, only a
  80.       part of a large file is kept in memory at one time.  Periodically,
  81.       it is necessary to write the early part of the buffer and append new
  82.       lines from the input file.  The default value for /B, 500, specifies
  83.       that the buffer should be written after every 500 lines are processed.
  84.       This value should suffice for most files you will encounter.  If the
  85.       file has extremely long lines, then use /B to specify a smaller value
  86.       such as 250.
  87.    /N turns off the special feature of placing the deleted lines in the
  88.       difference file although it will not prevent EdLin from listing the
  89.       lines to be deleted just before they are actually deleted.
  90.  
  91. There are two possible options that are not enabled in the standard version
  92. because 1) they slow down the processing, 2) they require extra space, and
  93. 3) they are not normally required.  Both options are primarily for special
  94. purpose use by users who somehow managed to mix both spaces and tabs within
  95. their various versions of a program, or perhaps have run a program formatter
  96. on their code and have thus significantly changed the white space distribution.
  97. If you enable these options, /L and /W, by DEFINEing the compiler directive
  98. WHITEOPTIONS below, then
  99.  
  100.    /L will consider two lines identical even if their leading white space
  101.       (tabs and spaces) are different.
  102.  
  103.    /W will consider two lines identical even if their imbedded white spaces
  104.       are different.  One word of caution.  If using /W, be aware that quoted
  105.       white space is still reduced to a single space for the purposes of
  106.       comparison.  This means that /W would prevent discovering the
  107.       difference between, for example, mystr := ' ' and mystr := '     '.
  108.  
  109. NOTE ABOUT EDLIN AND LARGE FILES
  110. All EdLin's from DOS version 3.0 through 3.3 that have been tested recently
  111. have a bug relating to the editing of large files.  EdLin is supposed to read
  112. lines only until its buffer is 3/4 full.  However, instead it reads lines
  113. until the buffer is completely full.  This means insertions cannot be done
  114. near the beginning of the file and any attempt to make insertions early will
  115. result in an "insufficient memory" message.  The obvious solution is to get
  116. a corrected version of EdLin from Microsoft.  However, Microsoft has informed
  117. me that the only way to do this is to buy DOS 4.0.
  118.  
  119. Here's an alternative solution.  You may skip the rest of this documentation
  120. section until you want to DifEdl on a large file (greater than about 48k)
  121. and it will have insertions in the first 48k.
  122.  
  123. First, create a text file of your own (say, DUMMY) that contains, say, 100
  124. full lines (say about 70 characters each).  Make sure you know exactly how
  125. many lines are in DUMMY.  (Don't try to help by making this file too big.
  126. DifEdl assumes there are always more than /B# lines left in the buffer.)
  127.  
  128. Secondly, prepend this file onto the file (say, TOBEFIXD.DOC) that is to be
  129. updated with the output of DifEdl (say, TOBEFIXD.DED) by using
  130.  
  131.    "copy DUMMY+TOBEFIXD.DOC TOBEFIXD.NEW"
  132.  
  133. Thirdly, edit the file TOBEFIXD.DED and insert the single line "1,100d" as
  134. the first line.
  135.  
  136. Finally, use the modified TOBEFIXD.DED to edit TOBEFIXD.NEW using
  137.  
  138.    "EdLin TOBEFIXD.NEW <TOBEFIXD.DED >EDLFILE"
  139.  
  140. The result will be that the buggy EdLin erroneously fills its buffer with
  141. the first part of TOBEFIXD.NEW.  However, the text read will include your
  142. added 100 lines from DUMMY.  The new first line in the modified TOBEFIXD.DED
  143. will delete these extraneous lines, thus freeing some buffer space.  At that
  144. point, the rest of the edit will usually proceed normally.  You can verify
  145. this by looking at the output of the edit in EDLFILE and making sure there
  146. are no error messages.
  147. }
  148. {****************************************************************************}
  149. {$DEFINE WHITEOPTIONS} {Place last to enable  "ignore white space" options}
  150. {$UNDEF  WHITEOPTIONS} {Place last to disable "ignore white space" options}
  151.  
  152. type
  153.    t_Str = string[255];    {used for all strings except those from files}
  154.  
  155.    t_StrPtr = ^t_Str;      {and these will let us find them on the heap}
  156.  
  157. const
  158.    DEFAULT_RESYNC  = 5;        {default for NumToResync}
  159.    DEFAULT_SMALL   = 1;        {default for SmallDiffs}
  160.    DEFAULT_MAX_LEN = 253;      {default for MaxLineLen = max line for EdLin}
  161.    DEFAULT_BLOCK   = 500;      {default for EdLinBlock}
  162.  
  163. {$IFNDEF WHITEOPTIONS}
  164.    NUM_ARRAYS = 2; {only need one copy of old line and new line}
  165. {$ELSE}
  166.    NUM_ARRAYS = 4; {need original and reduced copy of both old and new lines}
  167. {$ENDIF}
  168.    {most of data segment is for 3 or 5 arrays for line number and pointers}
  169.    MAX_LINES = 64000 div (sizeof(longint) + (NUM_ARRAYS * sizeof(t_StrPtr)));
  170.    MAX_LINESM1 = MAX_LINES - 1; {used for array dimensions below}
  171.    DEFAULT_STR = #$0D#$0A;      {this string can never show up from ReadLn}
  172.    HEAP_RESERVE    = 2000;      {used for calculation which allocates heap}
  173.    MIN_NUM_IN_BUF  = 25;        {must end up with room for at least this many}
  174.    TEXT_BUF_SIZE   = 8192;      {used for readln of oldfile and newfile}
  175.  
  176. var
  177.    OldLineNum  : array [0..MAX_LINESM1] of longint;   {old file line numbers}
  178.    OldStrPtr   : array [0..MAX_LINESM1] of t_StrPtr;  {pointers to old lines}
  179.    NewStrPtr   : array [0..MAX_LINESM1] of t_StrPtr;  {pointers to new lines}
  180. {$IFDEF WHITEOPTIONS}
  181.    OldTrmPtr   : array [0..MAX_LINESM1] of t_StrPtr;  {pointers to old trimmed}
  182.    NewTrmPtr   : array [0..MAX_LINESM1] of t_StrPtr;  {pointers to new trimmed}
  183. {$ENDIF}
  184.  
  185.    NumToResync : word;        {number of successive matches to recover sync}
  186.    SmallDiffs  : word;        {number to resync if differences are small}
  187.    MaxLineLen  : word;        {maximum line length accepted}
  188.    EdLinBlock  : word;        {size of EdLin write/append blocks}
  189.  
  190.    NumInBuf    : word;        {number of items actually in the 3/5 line arrays}
  191.    MaxToSearch : word;        {maximum number of items to search}
  192.    OldFile     : text;        {the old input file}
  193.    NewFile     : text;        {the new input file}
  194.    OldNextIn   : word;        {array index for placing next old line read}
  195.    NewNextIn   : word;        {array index for placing next new line read}
  196.    OldNextOut  : word;        {array index for next old line to examine}
  197.    NewNextOut  : word;        {array index for next new line to examine}
  198.    OldInBuf    : word;        {count of number of old file lines in buffer}
  199.    NewInBuf    : word;        {count of number of new file lines in buffer}
  200.    OldLineCnt  : longint;     {counter for original line numbers in old file}
  201.    NewLineCnt  : longint;     {counter for original line numbers in new file}
  202.    ConFile     : text;        {for console output in case stdout redirected}
  203.    NeedNewLine : boolean;     {if abort, then clean up old line before message}
  204.    OutputDel   : boolean;     {include deleted lines in the difference output}
  205.  
  206. {$IFDEF WHITEOPTIONS}
  207.    TrimLeading : boolean;     {remove all leading white space}
  208.    TrimAllWhite: boolean;     {convert all white space to single space}
  209.  
  210. const
  211.    tabchr = #$09;
  212. {$ENDIF}
  213.  
  214. {****************************************************************************}
  215. {display usage information and halt}
  216. procedure Usage;
  217. begin
  218.    writeln (ConFile, #$07);
  219.    write   (ConFile, 'USAGE: DifEdl oldfile newfile [/R#] [/D#] [/M#] [/B#] ');
  220. {$IFDEF WHITEOPTIONS}
  221.    write   (ConFile, '[/W] [/L] ');
  222. {$ENDIF}
  223.    writeln (ConFile, '[>diffile]');
  224.    writeln (ConFile);
  225.    writeln (ConFile, '/R# (   5) -- number of consecutive lines that must match to re-sync  (2-20)');
  226.    writeln (ConFile, '/D# (   1) -- number of lines to match when small difference is found (1-/R)');
  227.    writeln (ConFile, '/M# ( 253) -- maximum line length (1-255)');
  228.    writeln (ConFile, '/B# ( 500) -- size of EdLin write/append sequences (100-1000)');
  229.    writeln (ConFile, '/N         -- do not include deleted lines in the output');
  230. {$IFDEF WHITEOPTIONS}
  231.    writeln (ConFile, '/W  ( off) -- compare with all groups of white space changed to single spaces');
  232.    writeln (ConFile, '/L  ( off) -- compare with all leading white space eliminated');
  233. {$ENDIF}
  234.    halt (1);
  235. end; {Usage}
  236.  
  237. {****************************************************************************}
  238. procedure Abort (msg : t_Str);
  239. begin
  240.    if (NeedNewLine) then
  241.       writeln (ConFile);
  242.    writeln (ConFile, #$07, msg);
  243.    halt(254);
  244. end; {Abort}
  245.  
  246. {****************************************************************************}
  247. {increment an array index, wrapping to the beginning if necessary}
  248. function IncNdx (ndx  : word;
  249.                  incr : word
  250.                 )     : word;
  251. {the body of this function was converted so that it is an inline directive}
  252. {
  253. begin
  254.    inc (ndx, incr);
  255.    if (ndx < NumInBuf) then
  256.       IncNdx := ndx
  257.    else
  258.       IncNdx := ndx - NumInBuf;
  259. end;
  260. }
  261. Inline(
  262.   $58/                   {      pop ax            ;get index}
  263.   $5B/                   {      pop bx            ;get increment}
  264.   $01/$D8/               {      add ax,bx         ;increment index}
  265.   $3B/$06/>NUMINBUF/     {      cmp ax,[>NumInBuf];check it}
  266.   $7C/$04/               {      jl  out           ;skip if ok}
  267.   $2B/$06/>NUMINBUF      {      sub ax,[>NumInBuf];wrap index}
  268.  );                      {out:                    ;label for end}
  269.  
  270. {****************************************************************************}
  271. {$IFDEF WHITEOPTIONS}
  272. {remove leading white space and/or reduce all white space sequences to 1 space}
  273. function ReduceWhiteSpace (tstr : t_Str
  274.                           )     : t_Str;
  275. var
  276.    ndx : integer;
  277. begin
  278.    if (TrimLeading) then
  279.       begin
  280.          while ((length(tstr) > 0) and
  281.                 ((tstr[1] = ' ') or (tstr[1] = tabchr))) do
  282.             delete (tstr, 1, 1);
  283.       end;
  284.    if (not TrimAllWhite) then
  285.       begin
  286.          ReduceWhiteSpace := tstr;
  287.          exit;
  288.       end;
  289.    {first convert all spaces to tabs}
  290.    ndx := pos (' ', tstr);
  291.    while (ndx > 0) do
  292.       begin
  293.          tstr[ndx] := tabchr;
  294.          ndx := pos (' ', tstr);
  295.       end;
  296.    {now convert all series of tabs to a single space}
  297.    ndx := pos (tabchr, tstr);
  298.    while (ndx > 0) do
  299.       begin
  300.          tstr[ndx] := ' ';
  301.          while ((ndx < length(tstr)) and (tstr[ndx+1] = tabchr)) do
  302.             delete (tstr, ndx+1, 1);
  303.          ndx := pos (tabchr, tstr);
  304.       end;
  305.    ReduceWhiteSpace := tstr;
  306. end; {ReduceWhiteSpace}
  307. {$ENDIF}
  308.  
  309. {****************************************************************************}
  310. procedure GetOldRecord;
  311. var
  312.    tempstr : t_Str;
  313.    ndx     : word;
  314.    tempndx : word;
  315. begin
  316.    if (not eof(OldFile)) then
  317.       begin
  318.          inc(OldLineCnt);
  319.          OldLineNum[OldNextIn] := OldLineCnt;
  320.          Readln (OldFile, tempstr);
  321.          if (length(tempstr) > MaxLineLen) then
  322.             Abort ('Old file contains lines that are too long');
  323.          OldStrPtr[OldNextIn]^ := tempstr;
  324. {$IFDEF WHITEOPTIONS}
  325.          OldTrmPtr[OldNextIn]^ := ReduceWhiteSpace (tempstr);
  326. {$ENDIF}
  327.          OldNextIn := IncNdx (OldNextIn,1);
  328.          inc (OldInBuf);
  329.       end;
  330.    if (eof(Oldfile)) then
  331.       for ndx := 0 to pred(NumToResync) do
  332.          begin
  333.             tempndx := IncNdx (OldNextIn, ndx);
  334.             OldLineNum[tempndx] := succ(OldLineCnt) + ndx;
  335.             OldStrPtr[tempndx]^ := DEFAULT_STR;
  336. {$IFDEF WHITEOPTIONS}
  337.             OldTrmPtr[tempndx]^ := DEFAULT_STR;
  338. {$ENDIF}
  339.          end;
  340. end; {GetOldRecord}
  341.  
  342. {****************************************************************************}
  343. procedure GetNewRecord;
  344. var
  345.    tempstr : t_Str;
  346.    ndx     : word;
  347.    tempndx : word;
  348. begin
  349.    if (not eof(NewFile)) then
  350.       begin
  351.          inc(NewLineCnt);
  352.          Readln (NewFile, tempstr);
  353.          if (length(tempstr) > MaxLineLen) then
  354.             Abort ('New file contains lines that are too long');
  355.          NewStrPtr[NewNextIn]^ := tempstr;
  356. {$IFDEF WHITEOPTIONS}
  357.          NewTrmPtr[NewNextIn]^ := ReduceWhiteSpace (tempstr);
  358. {$ENDIF}
  359.          NewNextIn := IncNdx (NewNextIn,1);
  360.          inc (NewInBuf);
  361.       end;
  362.    if (eof(NewFile)) then
  363.       for ndx := 0 to pred(NumToResync) do
  364.          begin
  365.             tempndx := IncNdx (NewNextIn, ndx);
  366.             NewStrPtr[tempndx]^ := DEFAULT_STR;
  367. {$IFDEF WHITEOPTIONS}
  368.             NewTrmPtr[tempndx]^ := DEFAULT_STR;
  369. {$ENDIF}
  370.          end;
  371. end; {GetNewRecord}
  372.  
  373. {****************************************************************************}
  374. {process command line options that follow file names}
  375. procedure ProcessOptions (var ShowInfo : boolean);
  376. var
  377.    ndx          : integer;
  378.    tempstr      : t_Str;
  379.    retcode      : integer;
  380. begin
  381.    NumToResync := DEFAULT_RESYNC;
  382.    SmallDiffs  := DEFAULT_SMALL;
  383.    MaxLineLen  := DEFAULT_MAX_LEN;
  384.    EdLinBlock  := DEFAULT_BLOCK;
  385.    OutputDel   := true;
  386. {$IFDEF WHITEOPTIONS}
  387.    TrimLeading  := false;
  388.    TrimAllWhite := false;
  389. {$ENDIF}
  390.    ShowInfo := false;
  391.    if (ParamCount > 2) then
  392.       for ndx := 3 to ParamCount do
  393.          begin
  394.             tempstr := ParamStr(ndx);
  395.             if (tempstr[1] = '/') then
  396.                case upcase(tempstr[2]) of
  397.                   'R': begin
  398.                           delete (tempstr, 1, 2);
  399.                           val (tempstr, NumToResync, retcode);
  400.                           if ((retcode    <>  0) or
  401.                               (NumToResync <  2) or
  402.                               (NumToResync > 20)   ) then
  403.                              begin
  404.                                 writeln (ConFile, 'Invalid resync value');
  405.                                 Usage;
  406.                              end;
  407.                        end;
  408.                   'D': begin
  409.                           delete (tempstr, 1, 2);
  410.                           val (tempstr, SmallDiffs, retcode);
  411.                           if ((retcode   <>  0) or
  412.                               (SmallDiffs <  1) or
  413.                               (SmallDiffs > 20)   ) then
  414.                              begin
  415.                                 writeln (ConFile, 'Invalid small difference sync value');
  416.                                 Usage;
  417.                              end;
  418.                        end;
  419.                   'M': begin
  420.                           delete (tempstr, 1, 2);
  421.                           val (tempstr, MaxLineLen, retcode);
  422.                           if ((retcode   <>   0) or
  423.                               (MaxLineLen <   1) or
  424.                               (MaxLineLen > 255)   ) then
  425.                              begin
  426.                                 writeln (ConFile, 'Invalid maximum line length');
  427.                                 Usage;
  428.                              end;
  429.                        end;
  430.                   'B': begin
  431.                           delete (tempstr, 1, 2);
  432.                           val (tempstr, EdLinBlock, retcode);
  433.                           if ((retcode   <>    0) or
  434.                               (EdLinBlock <  100) or
  435.                               (EdLinBlock > 1000)   ) then
  436.                              begin
  437.                                 writeln (ConFile, 'Invalid EdLin write/append block size');
  438.                                 Usage;
  439.                              end;
  440.                        end;
  441.                   'I': ShowInfo := true;
  442.                   'N': OutputDel := false;
  443. {$IFDEF WHITEOPTIONS}
  444.                   'W': TrimAllWhite := true;
  445.                   'L': TrimLeading  := true;
  446. {$ENDIF}
  447.                   else begin
  448.                           writeln (ConFile, 'Invalid command line option');
  449.                           Usage;
  450.                        end;
  451.                end;
  452.          end;
  453.    if (SmallDiffs > NumToResync) then
  454.       begin
  455.          writeln (ConFile, 'Invalid small difference sync value');
  456.          Usage;
  457.       end;
  458. end; {ProcessOptions}
  459.  
  460. {****************************************************************************}
  461. {initialize everything}
  462. procedure Initialize;
  463. var
  464.    OldName      : t_Str;
  465.    NewName      : t_Str;
  466.    ndx          : integer;
  467.    MaxToRead    : word;
  468.    ShowInfo     : boolean;
  469.    BufferPtr    : pointer;
  470.    LongNumInBuf : longint;
  471. begin
  472.    assign (ConFile, 'CON');
  473.    rewrite (ConFile);
  474.    writeln (ConFile, NAME_AND_VERSION);
  475.  
  476.    {handle file names}
  477.    if (ParamCount < 2) then
  478.       Usage;
  479.    OldName := ParamStr (1);
  480.    assign (OldFile, OldName);
  481.    {$I-} reset (OldFile); {$I+}
  482.    if (IOResult <> 0) then
  483.       Abort ('Cannot open old file');
  484.    if (MaxAvail < TEXT_BUF_SIZE) then
  485.       Abort ('Cannot allocate old file text buffer');
  486.    GetMem (BufferPtr, TEXT_BUF_SIZE);
  487.    SetTextBuf (OldFile, BufferPtr^, TEXT_BUF_SIZE);
  488.  
  489.    NewName := ParamStr(2);
  490.    assign (NewFile, NewName);
  491.    {$I-} reset (NewFile); {$I+}
  492.    if (IOResult <> 0) then
  493.       Abort ('Cannot open new file');
  494.    if (MaxAvail < TEXT_BUF_SIZE) then
  495.       Abort ('Cannot allocate new file text buffer');
  496.    GetMem (BufferPtr, TEXT_BUF_SIZE);
  497.    SetTextBuf (NewFile, BufferPtr^, TEXT_BUF_SIZE);
  498.  
  499.    ProcessOptions (ShowInfo);
  500.  
  501.    {set up the circular line buffers}
  502.    LongNumInBuf := (MaxAvail - HEAP_RESERVE) div (NUM_ARRAYS * succ(MaxLineLen));
  503.    if (LongNumInBuf > MAX_LINES) then
  504.       LongNumInBuf := MAX_LINES;
  505.    NumInBuf := LongNumInBuf;
  506.    if (NumInBuf < (MIN_NUM_IN_BUF + NumToResync + NumToResync)) then
  507.       Abort ('Not enough memory for adequate line buffers');
  508.    MaxToRead := NumInBuf - NumToResync;    {always leave room for filler}
  509.    MaxToSearch := MaxToRead - NumToResync; {make sure have match past end}
  510.  
  511.    for ndx := 0 to pred(NumInBuf) do
  512.       begin
  513.          OldLineNum[ndx] := succ(ndx);
  514.          if (MaxAvail < succ(MaxLineLen)) then
  515.             Abort ('Error in memory allocation algorithm');
  516.          getmem (OldStrPtr[ndx], succ(MaxLineLen));
  517.          OldStrPtr[ndx]^ := DEFAULT_STR;
  518.          if (MaxAvail < succ(MaxLineLen)) then
  519.             Abort ('Error in memory allocation algorithm');
  520.          getmem (NewStrPtr[ndx], succ(MaxLineLen));
  521.          NewStrPtr[ndx]^ := DEFAULT_STR;
  522. {$IFDEF WHITEOPTIONS}
  523.          if (MaxAvail < succ(MaxLineLen)) then
  524.             Abort ('Error in memory allocation algorithm');
  525.          getmem (OldTrmPtr[ndx], succ(MaxLineLen));
  526.          OldTrmPtr[ndx]^ := DEFAULT_STR;
  527.          if (MaxAvail < succ(MaxLineLen)) then
  528.             Abort ('Error in memory allocation algorithm');
  529.          getmem (NewTrmPtr[ndx], succ(MaxLineLen));
  530.          NewTrmPtr[ndx]^ := DEFAULT_STR;
  531. {$ENDIF}
  532.       end;
  533.  
  534.    {fill the old file buffer}
  535.    OldNextIn := 0;
  536.    OldNextOut := 0;
  537.    OldLineCnt := 0;
  538.    OldInBuf := 0;
  539.    while ((not eof(OldFile)) and (OldNextIn < MaxToRead)) do
  540.       GetOldRecord;
  541.  
  542.    {fill the new file buffer}
  543.    NewNextIn := 0;
  544.    NewNextOut := 0;
  545.    NewLineCnt := 0;
  546.    NewInBuf := 0;
  547.    while ((not eof(NewFile)) and (NewNextIn < MaxToRead)) do
  548.       GetNewRecord;
  549.  
  550.    if (ShowInfo) then
  551.       begin
  552.          writeln (ConFile, 'There is room for ', NumInBuf, ' lines of ',
  553.                   MaxLineLen, ' characters in each of ',
  554.                   NUM_ARRAYS, ' arrays.');
  555.          writeln (ConFile, 'The initial read obtained ', OldInBuf,
  556.                   ' old records and ', NewInBuf, ' new records.');
  557.          writeln (ConFile, 'Re-sync values are ', NumToResync, ' and ',
  558.                   SmallDiffs, ' and the EdLin block size is ', EdLinBlock, '.');
  559.       end;
  560. end; {Initialize}
  561.  
  562. {****************************************************************************}
  563. {checks if the next sync lines match}
  564. function CheckSync (sync : word;
  565.                     onum : word;
  566.                     nnum : word
  567.                    )     : boolean;
  568. var
  569.    ndx : word;
  570. begin
  571.    checksync := false;
  572.    for ndx := 0 to pred(sync) do
  573. {$IFNDEF WHITEOPTIONS}
  574.       if (OldStrPtr[IncNdx(OldNextOut,onum+ndx)]^ <>
  575.           NewStrPtr[IncNdx(NewNextOut,nnum+ndx)]^) then
  576.          exit;
  577. {$ELSE}
  578.       if (OldTrmPtr[IncNdx(OldNextOut,onum+ndx)]^ <>
  579.           NewTrmPtr[IncNdx(NewNextOut,nnum+ndx)]^) then
  580.          exit;
  581. {$ENDIF}
  582.    checksync := true;
  583. end; {CheckSync}
  584.  
  585. {****************************************************************************}
  586. {slide the buffers against each other trying to find sync successive matches}
  587. procedure RecoverSync (      sync : word;
  588.                        var oldcnt : word;
  589.                        var newcnt : word
  590.                       );
  591. var
  592.    outerndx : word;
  593.    innerndx : word;
  594.    maxndx   : word;
  595. begin
  596.    if (OldInBuf > NewInBuf) then
  597.       maxndx := succ(OldInBuf)  {this is actually one too many}
  598.    else
  599.       maxndx := succ(NewInBuf); {this is actually one too many}
  600.    if (maxndx > MaxToSearch) then
  601.       maxndx := MaxToSearch;    {need to allow data or filler past end}
  602.    for outerndx := 0 to pred(maxndx) do
  603.       for innerndx := 0 to outerndx do
  604.          begin
  605.             {actually checks one past end and will find filler as last resort}
  606.             if ((outerndx <= OldInBuf) and
  607.                 (innerndx <= NewInBuf)) then
  608.                begin
  609.                   if (checksync (sync, outerndx, innerndx)) then
  610.                      begin
  611.                         oldcnt := outerndx;
  612.                         newcnt := innerndx;
  613.                         exit;
  614.                      end;
  615.                end;
  616.             {actually checks one past end and will find filler as last resort}
  617.             if ((innerndx <> outerndx) and
  618.                 (innerndx <= OldInBuf) and
  619.                 (outerndx <= NewInBuf)) then
  620.                begin
  621.                   if (checksync (sync, innerndx, outerndx)) then
  622.                      begin
  623.                         oldcnt := innerndx;
  624.                         newcnt := outerndx;
  625.                         exit;
  626.                      end;
  627.                end;
  628.          end;
  629.    Abort ('Cannot recover synchronization -- files too different');
  630. end; {RecoverSync}
  631.  
  632. {****************************************************************************}
  633. {remove one line from the old buffer and try to read a replacement from file}
  634. procedure AdvanceOld;
  635. begin
  636.    OldNextOut := IncNdx (OldNextOut, 1);
  637.    dec (OldInBuf);
  638.    GetOldRecord;
  639. end; {AdvanceOld}
  640.  
  641. {****************************************************************************}
  642. {remove one line from the new buffer and try to read a replacement from file}
  643. procedure AdvanceNew;
  644. begin
  645.    NewNextOut := IncNdx (NewNextOut, 1);
  646.    dec (NewInBuf);
  647.    GetNewRecord;
  648. end; {AdvanceNew}
  649.  
  650. {****************************************************************************}
  651. {control the process of comparing the files against each other}
  652. procedure ComparEm;
  653. var
  654.    NextDot     : longint;
  655.    OldLineBias : longint;
  656.    oldcnt      : word;
  657.    newcnt      : word;
  658.    tempold     : word;
  659.    tempnew     : word;
  660.    tbeg        : word;
  661.    tend        : word;
  662.    count       : word;
  663.    AllMatch    : boolean;
  664. begin
  665.    AllMatch := true;
  666.    NeedNewLine := true;
  667.    NextDot := 0;
  668.    OldLineBias := 0;
  669.    {loop while there are any lines left in either buffer}
  670.    while ((OldNextOut <> OldNextIn) or (NewNextOut <> NewNextIn)) do
  671.       begin
  672.          if (OldLineNum[OldNextOut] > NextDot) then
  673.             begin
  674.                write (ConFile, '.');
  675.                inc(NextDot,100);
  676.             end;
  677.          {check if the current lines in each buffer match}
  678. {$IFNDEF WHITEOPTIONS}
  679.          if (OldStrPtr[OldNextOut]^ = NewStrPtr[NewNextOut]^) then
  680. {$ELSE}
  681.          if (OldTrmPtr[OldNextOut]^ = NewTrmPtr[NewNextOut]^) then
  682. {$ENDIF}
  683.             begin
  684.                {the lines match, so just skip them}
  685.                AdvanceOld;
  686.                AdvanceNew;
  687.             end
  688.          else
  689.             begin
  690.                {the lines don't match, so recover sync}
  691.                AllMatch := false;
  692.                RecoverSync (NumToResync, oldcnt, newcnt);
  693.                {if the change was only a small addition and/or deletion}
  694.                if ((SmallDiffs < NumToResync) and
  695.                    (oldcnt < NumToResync) and
  696.                    (newcnt < NumToResync)) then
  697.                   {then the following statement handles small changes better}
  698.                   {when the small changes are closely grouped together}
  699.                   RecoverSync (SmallDiffs, oldcnt, newcnt);
  700.                {loop while there's any lines left to delete or insert}
  701.                while ((oldcnt > 0) or (newcnt > 0)) do
  702.                   begin
  703.                      {this code splits big updates into small chunks for EdLin}
  704.                      if (oldcnt > EdLinBlock) then
  705.                         tempold := EdLinBlock
  706.                      else
  707.                         tempold := oldcnt;
  708.                      if (newcnt > EdLinBlock) then
  709.                         tempnew := EdLinBlock
  710.                      else
  711.                         tempnew := newcnt;
  712.                      dec (oldcnt, tempold);
  713.                      dec (newcnt, tempnew);
  714.  
  715.                      {move lines through EdLin's buffer to handle large files}
  716.                      while ((OldLineNum[OldNextOut] + OldLineBias) > EdLinBlock) do
  717.                         begin
  718.                            writeln (EdLinBlock,'WA');
  719.                            dec (OldLineBias, EdLinBlock)
  720.                         end; {while}
  721.  
  722.                      {the lines skipped in the old buffer are to be deleted}
  723.                      {list and delete the lines, then insert and remove what}
  724.                      {SHOULD have been deleted for comparison}
  725.                      if (tempold > 0) then
  726.                         begin
  727.                            tbeg := OldLineNum[OldNextOut] + OldLineBias;
  728.                            tend := tbeg + tempold - 1;
  729.                            write   (tbeg, ',', tend, 'L  '); {list lines}
  730.                            writeln (tbeg, ',', tend, 'D');   {delete them}
  731.                            if (OutputDel) then
  732.                               writeln (tbeg, 'I  ', tbeg, ',', tend, 'D');
  733.                            for count := 1 to tempold do
  734.                               begin
  735.                                  if (OutputDel) then
  736.                                     writeln (OldStrPtr[OldNextOut]^);
  737.                                  AdvanceOld;
  738.                               end;
  739.                            if (OutputDel) then
  740.                               write (#$03);
  741.                            dec (OldLineBias, tempold);
  742.                         end; {if tempold}
  743.  
  744.                      {the lines skipped in the new buffer are to be inserted}
  745.                      if (tempnew > 0) then
  746.                         begin
  747.                            writeln (OldLineNum[OldNextOut] + OldLineBias, 'I');
  748.                            for count := 1 to tempnew do
  749.                               begin
  750.                                  writeln (NewStrPtr[NewNextOut]^);
  751.                                  AdvanceNew;
  752.                               end;
  753.                            write (#$03);
  754.                            inc (OldLineBias, tempnew);
  755.                         end; {if tempnew}
  756.                   end; {while}
  757.             end; {else}
  758.       end; {while}
  759.    writeln (ConFile);
  760.    NeedNewLine := false;
  761.    if (not AllMatch) then
  762.       writeln ('E')
  763.    else
  764.       writeln (ConFile, 'No differences were found.');
  765. end; {CompareEm}
  766.  
  767. {****************************************************************************}
  768. procedure FinishUp;
  769. begin
  770.    close (OldFile);
  771.    close (NewFile);
  772. end; {FinishUp}
  773.  
  774. {****************************************************************************}
  775. begin
  776.    Initialize;
  777.    ComparEm;
  778.    FinishUp;
  779. end.
  780.